Tutoriels

Sommaire

Création d'un générateur aléatoire avec modificateurs d'états

Création d'un générateur aléatoire avec modificateurs d'états

    Date de publication : 24/02/2022 16:44:34

Dans le cadre de la création du langage de marquage MarkIt, il était indispensable pour moi de générer des documents aléatoires afin de tester toutes les fonctionnalités du programme et de vérifier la mise en page.

Il était donc nécessaire de créer un générateur prenant en compte les spécificités de du langage et éviter les incohérences de structure du document:

  • Limitation de la profondeur des listes

  • Pas d'en-têtes dans les listes, les tableaux, les notes, …

  • …

La bibliothèque quickcheck permet bien de générer des valeurs aléatoires avec différents modificateurs mais pas de modifier l'état des générateurs en cours de fonctionnement.

Pour pouvoir le faire, il faut donc passer par une bibliothèque gérant les états (transformers par exemple) et plus particulièrement le modificateur StateT qui permet de créer une monade state "modifiée" contenant une monade d'un autre type.

import           Control.Monad
import           Control.Monad.Trans.Class
import           Control.Monad.Trans.State
import           Test.QuickCheck
import           Test.QuickCheck.Gen
Copy

Supposons que l'on veuille générer des structures de données avec le type suivant en limitant la profondeur, en forçant le premier élément à être un en-tête et avec des générateurs spécifiques à chaque niveau de profondeur.

data MyElem = Header String
              | Upper [MyElem]
              | Str [String]
              | Tag String
              deriving(Show)
Copy

Il nous faut donc un état qui contiendra les différents paramètres permettant de modifier les générateurs en cours d'exécution:

data MyState = MyState
    { lastHeader :: Maybe String -- ^ The title of the last header (If a header is passed).
    , level      :: Int          -- ^ The level (depth) where we are in the structure.
    , usedTags   :: [String]     -- ^ The list of laready used tags.
    }

initState = MyState
    { lastHeader = Nothing
    , level = 1
    , usedTags = []
    }
Copy

On utilise le type StateT pour modifier et créer un nouveau monad embarquant l'état MyState et permettant de faire tournant des monads Gen (provenant de la bibliothèque quickcheck) à l'intérieur. 

type MyGen t = StateT MyState Gen t
Copy

Le lancement des fonctions de générations à l'intérieur de la monade MyGen se fait à l'aide de la fonction lift

genUpper :: MyGen MyElem
genUpper = do
    modify (\st -> st { level = level st + 1 })
    es <- genBase
    modify (\st -> st { level = level st - 1 })
    return $ Upper es


genElems :: MyGen [MyElem]
genElems = do
    l <- gets level
    if l == 1
        then vectorOfM 6 $ oneofM [genStr, genHeader, genUpper, genTag]
        else if l > 4 -- Limit the depth to 4
            then vectorOfM 3 $ oneofM [genStr, genTag]
            else vectorOfM 4 $ oneofM [genStr, genUpper, genTag]


genStr :: MyGen MyElem
genStr = do
    l <- gets level
    v <- lift $ case l of -- Set the maximum string length according to the level of the structure.
        1 -> choose (5, 10)
        2 -> choose (3, 7)
        _ -> choose (1, 5)
    s <- lift $ vectorOf v $ elements ["Lorem", "Ispum", "Dolor", "Sit", "Amet", "Elit", "Duis", "Sagittis", "Tortor"]
    return $ Str s

genHeader :: MyGen MyElem
genHeader = do
    h <- lift $ elements ["A header", "Another header", "Still another header", "No more header"]
    modify (\st -> st { lastHeader = Just h })
    return $ Header h

genTag :: MyGen MyElem
genTag = do
    tgs <- gets usedTags
    let tag = head $ filter (`notElem` tgs) $ map (\i -> "TAG" ++ show i) [1 ..]
    modify (\st -> st { usedTags = tag : usedTags st }) -- Set the already used tags
    return $ Tag tag


genBase = do
    stat <- get
    case lastHeader stat of
        Nothing -> do -- Force the first element to be a Header.
            e  <- genHeader
            es <- genBase
            return $ e : es

        Just _ -> do
            genElems
Copy

Il sera nécessaire de faire des versions spécifiques de certaines fonctions (transformers) de la librairie quickcheck pour pouvoir les utiliser avec la nouvelle monade MyGen. Il faudra réécrire les fonctions décrites dans le module Test.QuickCheck.Gen.

vectorOfM :: Int -> MyGen t -> MyGen [t]
vectorOfM = replicateM

oneofM :: [MyGen t] -> MyGen t
oneofM [] = error "oneofM used with empty list"
oneofM gs = do
    v <- lift $ choose (0, length gs - 1)
    gs !! v
Copy

Une fois ce travail fait, on peut générer des strcutures aléatoires en combinant les fonctions generate du module quickcheck et evalStateT du module 

main = do
    struct <- generate $ evalStateT genBase initState
    print struct
Copy

et on peut générer les structures souhaitées:

[ Header "No more header"
, Tag "TAG1"
, Tag "TAG2"
, Header "A header"
, Str ["Dolor", "Sit", "Dolor", "Elit", "Lorem", "Amet", "Ispum"]
, Header "Another header"
, Header "No more header"
]
Copy
[ Header "Still another header"
, Str
    [ "Dolor"
    , "Sagittis"
    , "Amet"
    , "Sagittis"
    , "Sagittis"
    , "Duis"
    , "Duis"
    , "Duis"
    , "Lorem"
    , "Tortor"
    ]
, Header "Another header"
, Header "Another header"
, Upper
    [ Upper
        [ Str ["Tortor", "Duis", "Tortor"]
        , Str ["Duis", "Amet", "Tortor", "Amet"]
        , Upper
            [ Upper
                [ Str ["Lorem", "Sit", "Tortor", "Tortor"]
                , Str ["Elit", "Lorem", "Duis", "Sagittis", "Amet"]
                , Tag "TAG1"
                ]
            , Upper
                [ Tag "TAG2"
                , Tag "TAG3"
                , Str ["Lorem", "Duis", "Ispum", "Duis", "Elit"]
                ]
            , Str ["Elit", "Duis", "Lorem", "Amet"]
            , Upper
                [ Str ["Sagittis", "Sagittis", "Dolor", "Tortor", "Sit"]
                , Tag "TAG4"
                , Tag "TAG5"
                ]
            ]
        , Str ["Amet"]
        ]
    , Tag "TAG6"
    , Upper
        [ Upper
            [ Str ["Ispum", "Sit"]
            , Upper [Str ["Lorem"], Str ["Duis", "Sit"], Tag "TAG7"]
            , Tag "TAG8"
            , Tag "TAG9"
            ]
        , Upper
            [ Str ["Sit", "Lorem", "Dolor", "Sagittis", "Sagittis"]
            , Tag "TAG10"
            , Str ["Tortor", "Ispum", "Duis", "Elit"]
            , Tag "TAG11"
            ]
        , Str ["Duis", "Duis", "Amet", "Tortor", "Lorem"]
        , Upper
            [ Tag "TAG12"
            , Tag "TAG13"
            , Upper
                [ Str ["Sagittis", "Tortor", "Elit", "Dolor"]
                , Str ["Ispum", "Duis", "Sit"]
                , Tag "TAG14"
                ]
            , Str ["Elit", "Lorem", "Sagittis"]
            ]
        ]
    , Tag "TAG15"
    ]
, Header "No more header"
, Header "A header"
]
Copy